perm filename HX.F4[NEW,LCS] blob
sn#502578 filedate 1980-03-29 generic text, type T, neo UTF8
36600 SUBROUTINE RREAD(I,V)
36700 C TAKES ASCII INPUT (INP) STRING, SEPARATES LETTERS FROM NUMBERS.
36800 C MAKES ALL NUMBS FLTING PT. FILLS UP END OF ARRAY WITH ZEROS.
36900 C SENDS BACK IN V ARRAY.
37000 C E.G. 'GET FOO 4.55' SENDS BACK V1=0, V2=0, V3=4.55, V4=0, ETC.
37100 DIMENSION I(1),V(1)
37200 EQUIVALENCE (N,RN)
37300 DO 62 J=1,22
37400 C ZERO V AND IV ARRAYS. (COULD BE 30 ABOVE.)
37500 62 V(J)=0
37600 DO 6 LEND=71,1,-1
37700 6 IF(I(LEND).NE.' ')GO TO 7
37800 C LEND=END OF CHARS. STARTS WITH NEXT-TO-LAST (LAST IS *)
37900 RETURN
38000 7 M=1
38100 J=1
38200 8 N=I(J)
38300 CALL LO2UP(N)
38400 IF(N.EQ.' ')GO TO 16
38500 C IF(N.NE.'-'.AND.
38600 C 1 N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
38610 IF( N.NE.'.'.AND.(N.LT.'0'.OR.N.GT.'9'))GO TO 10
38700 C NOW IT'S A NUMBER
38800 20 CALL NUMZ(KK,I(J),V(M))
38900 J=J+KK-1
39000 10 M=M+1
39100 16 J=J+1
39200 IF(J.LE.LEND)GO TO 8
39300 END
39400
39500 SUBROUTINE NUMZ(KK,I,X)
39600 DIMENSION I(1)
39700 DATA IZERO/'0'/,ININE/'9'/
39800 J=-1
39900 M=0
40000 XMINUS=1.
40050 IF(I(0).EQ.'-')XMINUS=-XMINUS
40075 C I(0) MIGHT NOT WORK WITH SOME FORTRANS!!
40100 DO 21 KK=1,15
40200 C IS 15 ENOUGH? YES, WILL DO ONLY 8 DIGITS PLUS DECI.PT.
40300 IX=I(KK)
40400 IF(IX.GE.IZERO.AND.IX.LE.ININE)GO TO 22
40500 C IF(IX.EQ.'-')GO TO 24
40600 IF(IX.NE.'.')GO TO 20
40700 J=KK
40800 GO TO 21
40900 C 24 XMINUS=-XMINUS
41000 C GO TO 21
41100 22 N=(IX-IZERO)/536870912
41200 M=N+M*10
41300 21 CONTINUE
41400 20 IF(J.LT.0)GO TO 23
41500 X=KK-J-1
41600 X=XMINUS*M/(10.**X)
41700 RETURN
41800 23 X=XMINUS*M
41900 C FOR NO DECI.
42000 END
42100
42200 SUBROUTINE NUMLTR(L,J)
42300 C THIS, AND ABOVE ROUTINES, TAKES CARE OF STANFORD 'REREAD' FEATURE
42400 C 'RREAD' IS CALLED JUST AFTER ORIGINAL READ STATEMENT
42500 COMMON R2,JA,CEN,J2,RJQ(20) /SCM/V(22)
42600 J=V(1)
42700 N=L+1
42800 R2=V(N)
42900 DO 1 K=1,20
43000 1 RJQ(K)=V(K+N)
43100 END